home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
TAN_SND.ARJ
/
SONG.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-07-28
|
2KB
|
92 lines
{ SONG.PAS - Demo of music and drum routines for Tandy 1000 and/or PCJr }
uses noiz,drums;
procedure check_key(var ch: char);
begin
if keyhit then
begin
ch:=upcase(fkey);
case ch of
'1': roto1(10,1);
'2': roto2(6,10);
'3': roto5(8,0,5);
'4': snare(10,2);
'5': begin
snare(4,8); snare(8,2); snare(4,4);
end;
'Q',
#27: begin
up(1,19,1); sound(e1); wait(50);
chord(e3,b3,fs4,32,17);
sound(e2); echo(80,long); writeln;
quiet; halt;
end;
'F': begin
writeln; quiet; halt;
end;
end;
end;
end;
procedure beat;
var
i,j: integer;
ch: char;
begin
i:=0; j:=0;
repeat
check_key(ch);
inc(i); inc(j);
case i of
10: begin
quiet;
roto5(8,20,2); sims(10,1);snare(8,2); tom(4,4); lowtom(8,2);
i:=0; j:=0;
end;
end;
case j of
1: chord(d4,fs4,b5,1,14);
2: chord(c4,g4,d4,1,14);
3: chord(a4,cs4,fs4,1,14);
4: chord(d4,a4,d5,1,14);
5: begin
snare(2,5); lowtom(1,10);
roto1(2,2); roto2(2,20);
j:=0;
end;
end;
sound(a2); bass(1,10);
sound(b2); snare(1,10);
sound(g2); lowtom(2,5);
sound(e2); snare(1,10);
until true = false;
end;
procedure main;
const
ray: array[1..8] of string[80] =
('1) Roto 1',
'2) Roto 2',
'3) Roto 5',
'4) Snare roll',
'5) Snare lick',
'Q) Quit with Ending',
'ESC) Quit with Ending',
'F) Halt with no Ending');
var
i: integer;
begin
writeln(#10' - Menu -'#10);
for i:=1 to 8 do writeln(' '+ray[i]);
write(#10' Command [1,2,3,4,5,Q,F]: ');
beat;
end;
begin
drums.inturbo:=false; noiz.inturbo:=false;
main;
end.